home *** CD-ROM | disk | FTP | other *** search
/ PD Collection CD 1 / PD Collection CD 1.iso / programer2 / pari2 / pari / other / gpreadline < prev    next >
Text File  |  1991-11-28  |  15KB  |  511 lines
  1. /*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
  2. /*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
  3. /*@                                                               @*/
  4. /*@                        PARI CALCULATOR                        @*/
  5. /*@                                                               @*/
  6. /*@                      copyright Babe Cool                      @*/
  7. /*@                                                               @*/
  8. /*@                                                               @*/
  9. /*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
  10. /*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
  11.  
  12. #include "genpari.h"
  13. #include <readline/readline.h>
  14. #include <readline/history.h>
  15.  
  16.  
  17. long    champ, dec, nbchi, avloc, avglob;
  18. long    prettyp = 1, chrono = 0;
  19. char    prompt[79], format;
  20.  
  21. #define NUMGLOB sizeof(globales)/4
  22.   
  23.   static char *globales[] = {"precision", "serieslength", "format", "prompt"};
  24.  
  25. void escape();
  26. void commands(), gentypes(), aide(), globs();
  27. long timer();
  28.  
  29. char* findsep(t)
  30.      char **t;
  31. {
  32.   char *s1;
  33.   static char s2[80];
  34.   int i;
  35.   
  36.   for(s1 = *t, i = 0; (i < 79) && (*s1) && (!separe(*s1)); i++) s2[i] = *s1++;
  37.   while ((*s1) && (!separe(*s1))) s1++;
  38.   s2[i] = 0; *t = s1;
  39.   return s2;
  40. }
  41.  
  42. void checkok(t)
  43.      char *t;
  44. {
  45.   char c = *t;
  46.   if((c) && (!separe(c))) err(caracer1,t);
  47. }
  48.  
  49. long getint(ch, n)
  50.      char *ch;
  51.      long n;
  52. {
  53.   long av = avma;
  54.   filtre(ch);
  55.   if (*ch) n = itos(readexpr(&ch));
  56.   avma = av; return n;
  57. }
  58. void usage(s)
  59.      char *s;
  60. {
  61.   pariputs("   ### usage: ");
  62.   pariputs(s);
  63.   pariputs("[-s stacksize] [-p primes] [-b buffersize]\n");
  64.   exit(0);
  65. }
  66.  
  67. main(argc,argv) 
  68.      long argc;
  69.      char **argv;
  70.      
  71. {
  72.   long  i,typy, parisize, primelimit, silent;
  73.   static long tloc,listloc;
  74.   char  *buffer, *tch, *tch2, thestring[100];
  75.   GEN  z;
  76.   long tmpparibuffsize=0;
  77.  
  78. #ifdef macintosh
  79.   strcpy(prompt,"?\n"); parisize = 1000000; primelimit = 200000;
  80. #else
  81.   strcpy(prompt,"? "); parisize = 4000000; primelimit = 500000;
  82. #endif
  83.   
  84.   for(i = 1; i < argc; i++)
  85.     {
  86.       tch = argv[i++];
  87.       if ((i == argc) || (*tch++ != '-')) usage(argv[0]);
  88.       if (*tch == 's') parisize = atoi(argv[i]);
  89.       else if (*tch == 'p') primelimit = atoi(argv[i]);
  90.       else if (*tch == 'b') tmpparibuffsize = atoi(argv[i]);
  91.       else usage(argv[0]);
  92.     }
  93.   
  94.   printversion();
  95.   pariputs("\n    Authors: C. Batut, D. Bernardi, H. Cohen and M. Olivier\n\n");
  96.   
  97.   init(parisize, primelimit);
  98.   if(tmpparibuffsize) paribuffsize=tmpparibuffsize;
  99.   buffer = (char *)malloc(paribuffsize);
  100.   
  101.   avglob = avloc = avma;
  102.   tglobal=0;chrono=0;
  103.   prec=5;precdl=16;dec=28;nbchi=28;champ=0;format='g';
  104.   
  105.   pariputs("Type \\d, \\c, \\t, or ?command for help, \\q to exit, # for timing\n\n");
  106.   globs(parisize,primelimit);
  107.   
  108.   for(;;)
  109.     {
  110.       avloc = avma; tloc = tglobal; listloc = marklist();
  111.       if (setjmp(environnement)) {avma = avloc; tglobal = tloc; recover(listloc);}
  112.       if(infile!=stdin)
  113.     {
  114.       if (!fgets(buffer, paribuffsize, infile)) {switchin(NULL); continue;}
  115.     }
  116.       else
  117.     {
  118.       pariputs(prompt);
  119. #ifdef _READLINE_H_
  120.       char    *_str;
  121.       int    _len;
  122.        
  123.       if(buffer) free(buffer);
  124.       do {
  125.         buffer = readline("");
  126.         if(!buffer) strcpy("\\q",buffer);
  127.         tch = buffer;
  128.         while (isspace(*tch)) tch++;
  129.       } while(!*tch);
  130.       if (*tch == '{')
  131.         for(*tch = ' ';;)
  132.           {
  133.         tch = buffer + strlen(buffer) - 1;
  134.         if (*tch == '}') {*tch = 0; break;}
  135.         if (*tch++ == '\\') tch--; else *tch++ = '\n';
  136.         _len = tch - buffer;
  137.         _str = readline("");
  138.         if(!_str) _str = "";
  139.         buffer = (char *)realloc(buffer, _len + strlen(_str));
  140.         strcpy(buffer + _len, _str);
  141.           }
  142.       else
  143.         for(;;)
  144.           {
  145.         tch = buffer + strlen(buffer) - 1;
  146.         if (*tch != '\\') break;
  147.         _len = tch - buffer;
  148.         _str = readline("");
  149.         if(!_str) _str = "";
  150.         buffer = (char *)realloc(buffer, _len + strlen(_str));
  151.         strcpy(buffer + _len, _str);
  152.           }
  153.       if(*buffer) add_history(buffer);
  154. #else
  155.       if (!fgets(buffer, paribuffsize, infile)) {switchin(NULL); continue;}
  156. #endif      
  157.     }
  158.       if (echo) pariputs(buffer); else if (logfile) fputs(buffer, logfile);
  159.       tch = buffer + 1;
  160.       switch(buffer[0])
  161.     {
  162.     case '#':
  163.       checkok(tch);
  164.       pariputs((chrono = !chrono) ? "    timer on\n" : "    timer off\n");
  165.       continue;
  166.     case '?': aide(findsep(&tch)); pariputc('\n'); continue;
  167.     case '\\': escape(tch,parisize,primelimit); continue;
  168.     case '{':
  169.       for(;;)
  170.         {
  171.           tch2 = buffer + strlen(buffer) - 1;
  172.           if (*tch2 == '\n') tch2--;
  173.           if (*tch2 == '}') {*tch2-- = 0; break;}
  174.           if (*tch2 != '\\') tch2++;
  175.           if(!fgets(tch2, paribuffsize - (tch2 - buffer), infile)) break;
  176.           if(echo) pariputs(tch2); else if (logfile) fputs(tch2, logfile);
  177.         }
  178.       break;
  179.     default:
  180.       for(tch--;;)
  181.         {
  182.           tch2 = buffer + strlen(buffer) - 1;
  183.           if (*tch2 == '\n') tch2--;
  184.           if (*tch2 != '\\') {tch2[1] = 0; break;}
  185.           if(!fgets(tch2, paribuffsize - (tch2 - buffer), infile)) break;
  186.           if(echo) pariputs(tch2); else if (logfile) fputs(tch2, logfile);
  187.         }                            
  188.       break;
  189.     }
  190.       silent = separe(*tch2);
  191.       filtre(tch);
  192.       fflush(outfile); if (logfile) fflush(logfile);
  193.       if (chrono) timer();
  194.       z = readseq(&tch);
  195.       nbchi=dec=glbfmt[2];
  196.       if (*tch) {pariputs("  unused characters: "); pariputs(tch); pariputc('\n');}
  197.       if (chrono)
  198.     {
  199.       long delay = timer();
  200.       pariputs("time = ");
  201.       if (delay >= 3600000)
  202.         {
  203.           sprintf(thestring, "%dh, ", delay / 3600000);
  204.           delay %= 3600000;
  205.           pariputs(thestring);
  206.         }
  207.       if (delay >= 60000)
  208.         {
  209.           sprintf(thestring, "%dmn, ", delay / 60000);
  210.           delay %= 60000;
  211.           pariputs(thestring);
  212.         }
  213.       if (delay >= 1000)
  214.         {
  215.           sprintf(thestring, "%d,", delay / 1000);
  216.           delay %= 1000;
  217.           pariputs(thestring);
  218.               if (delay < 100) pariputc('0');
  219.               if (delay < 10) pariputc('0');
  220.         }
  221.       sprintf(thestring, "%d ms\n", delay);
  222.       pariputs(thestring);
  223.     }
  224.       if (z == gnil) continue;
  225.       g[0] = g[++tglobal] = isonstack(z) ? z : gcopy(z);
  226.       typy=typ(z);
  227.       if (!separe(*tch2))
  228.     {
  229.       sprintf(thestring, "%%%d = ",tglobal);
  230.       pariputs(thestring);
  231.       if ((typy > 16) && (prettyp==2)) pariputc('\n');;
  232.       if(nbchi < 0)
  233.         if(prettyp==2) sor(z, format, -1, champ);
  234.         else if(prettyp) matbrute(z, format, -1);
  235.         else brute(z, format, -1);
  236.       else
  237.         if (typy < 3) ecrire(z, format, nbchi, 0);
  238.         else 
  239.           if(prettyp==2) sor(z, format, nbchi, champ);
  240.           else if(prettyp) matbrute(z, format, nbchi);
  241.           else brute(z, format, nbchi);
  242.       pariputc('\n'); 
  243.     }
  244.     } /* for(;;) */
  245. } /* main */
  246.  
  247. /********************************************************************/
  248. /********************************************************************/
  249. /**                                                                **/
  250. /**                    COMMANDES COMMENCANT PAR \                  **/
  251. /**                                                                **/
  252. /********************************************************************/
  253. /********************************************************************/
  254.  
  255. void escape(tch,parisize,primelimit)
  256.      char *tch;
  257.      long parisize,primelimit;
  258. {
  259.   int i, d;
  260.   char c, *s1, *s2, thestring[50];
  261.   
  262.   for (i=0;i<NUMGLOB;i++)
  263.     {
  264.       s1 = tch;
  265.       s2 = globales[i];
  266.       while ((*s2) && (*s1 == *s2)) {s1++; s2++;}
  267.       while (isspace(*s1)) s1++;
  268.       if (!*s2 && (*s1++ == '=')) 
  269.     switch (i) 
  270.       {
  271.       case 0: 
  272.         glbfmt[2] = nbchi = dec = getint(s1, dec);
  273.         prec = dec * K1 + 3;
  274.         sprintf(thestring, "   precision = %d significant digits\n",dec);
  275.         pariputs(thestring);
  276.         return;
  277.       case 1:
  278.         precdl = getint(s1);
  279.         sprintf(thestring, "   series precision = %d significant terms\n",precdl);
  280.         pariputs(thestring);
  281.         return;
  282.       case 2:
  283.         format = *s1++;
  284.         if(isdigit(*s1))
  285.           for(champ = 0; isdigit(*s1); s1++)
  286.         champ = 10 * champ + *s1 - '0';
  287.         if(*s1++ == '.')
  288.           if(*s1 == '-')
  289.         nbchi = -1;
  290.           else
  291.         if(isdigit(*s1))
  292.           for(nbchi = 0; isdigit(*s1); s1++)
  293.             nbchi = 10 * nbchi + *s1 - '0';
  294.         sprintf(thestring, "   real format = %c%d.%d\n", format, champ, nbchi);
  295.         pariputs(thestring);
  296.         glbfmt[0] = format; glbfmt[1] = champ; glbfmt[2] = nbchi;
  297.         return;
  298.       case 3:
  299.         strcpy(prompt, findsep(&s1));
  300. #ifdef macintosh
  301.         strcat(prompt,"\n");
  302. #else
  303.         strcat(prompt," ");
  304. #endif
  305.         return;
  306.       }
  307.     }
  308.   c = *tch++;
  309.   switch (isupper(c) ? tolower(c) : c)
  310.     {
  311.     case 'a': brute(g[getint(tch, tglobal)], format, -1);pariputc('\n');break;
  312.     case 'b': sor(g[getint(tch, tglobal)], format, -1, champ);pariputc('\n');
  313.       break;
  314.     case 'c': checkok(tch); commands(); break;
  315.     case 'd': checkok(tch); globs(parisize,primelimit); break;
  316.     case 'e': checkok(tch); echo = !echo; break;
  317.     case 'k': checkok(tch);
  318.       avma = avloc = avglob;
  319.       tglobal = chrono = 0;
  320.       gpi = geuler = bernzone = (GEN)0;
  321.       prec = 5; precdl = 16; dec = 28; nbchi = 28; champ = 0; format = 'g';
  322. #ifdef macintosh
  323.       strcpy(prompt,"?\n");
  324. #else
  325.       strcpy(prompt,"? ");
  326. #endif
  327.       for (i = 0; i < STACKSIZE; i++) g[i] = gzero;
  328.       globs(parisize,primelimit);
  329.       break;
  330.     case 'l': checkok(tch); fliplog(); break;
  331.     case 'm': matbrute(g[getint(tch, tglobal)], format, -1);pariputc('\n');
  332.       break;
  333.     case 'p': checkok(tch); prettyp = (prettyp==2)?0:prettyp+1;
  334.       if(prettyp==2) 
  335.     {
  336.       sprintf(thestring, "   default format: prettyprint\n");
  337.       pariputs(thestring);
  338.     }
  339.       else if(prettyp)
  340.     {
  341.       sprintf(thestring, "   default format: prettymatrix\n");
  342.       pariputs(thestring);
  343.     }
  344.       else
  345.     {
  346.       sprintf(thestring, "   default format: raw\n");
  347.       pariputs(thestring);
  348.     }
  349.       break;
  350.     case 'q': exit(0);
  351.     case 'r': while(isspace(*tch)) tch++; switchin(findsep(&tch)); break;
  352.     case 's': etatpile(getint(tch, 0)); break;
  353.     case 't': checkok(tch); gentypes(); break;
  354.     case 'v': checkok(tch); printversion(); break;
  355.     case 'w':
  356.       while(isspace(*tch)) tch++;
  357.       for (d = 0; isdigit(*tch);) d = 10 * d + *tch++ - '0';
  358.       while(isspace(*tch)) tch++;
  359.       switchout(findsep(&tch));
  360.       brute(g[d ? d : tglobal], format, -1);
  361.       pariputc('\n'); switchout(NULL); break;
  362.     case 'x': voir(g[tglobal], getint(tch, -1)); break;
  363.     case '\\': break;
  364.     default: err(caracer1,tch+1);
  365.     }
  366. }
  367.  
  368. /********************************************************************/
  369. /********************************************************************/
  370. /**                                                                **/
  371. /**           AFFICHAGE TYPES, COMMANDES AIDES ET GLOBALES         **/
  372. /**                                                                **/
  373. /********************************************************************/
  374. /********************************************************************/
  375.  
  376. void gentypes()
  377.      
  378. {
  379.   pariputs("\n      List of the PARI types :");
  380.   pariputs("\n     -------------------------\n\n");
  381.   pariputs("  1  :long integers     [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
  382.   pariputs("  2  :long real numbers [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
  383.   pariputs("  3  :integermods       [ code ] [ mod  ] [ integer ]\n");
  384.   pariputs("  4  :irred. rationals  [ code ] [ num. ] [ den. ] \n");
  385.   pariputs("  5  :rational numbers  [ code ] [ num. ] [ den. ] \n");
  386.   pariputs("  6  :complex numbers   [ code ] [ real ] [ imag ] \n");
  387.   pariputs("  7  :p-adic numbers    [ cod1 ] [ cod2 ] [ p ] [ p^r ] [ integer]\n");
  388.   pariputs("  8  :quadratic numbers [ cod1 ] [ mod  ] [ real ] [ imag ]\n");
  389.   pariputs("  9  :polymods          [ code ] [ mod  ] [ polynomial ]\n");
  390.   pariputs(" -------------------------------------------------------------\n");
  391.   pariputs("  10 :polynomials       [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
  392.   pariputs("  11 :power series      [ cod1 ] [ cod2 ] [ man1 ] ... [ manl ]\n");
  393.   pariputs("  13 :irred. rat. func. [ code ] [ num. ] [ den. ]\n");
  394.   pariputs("  14 :rational function [ code ] [ num. ] [ den. ]\n");
  395.   pariputs("  17 :row vector        [ code ] [  x1  ] ... [  xl  ]  \n");
  396.   pariputs("  18 :column vector     [ code ] [  x1  ] ... [  xl  ]  \n");
  397.   pariputs("  19 :matrix            [ code ] [ col1 ] ... [ coll ]\n");
  398. }
  399.  
  400. void commands()
  401. {
  402.   int i, j;
  403.   
  404.   for (i = 0; i < NUMFUNC; i++)
  405.     {
  406.       if (!(i % 6)) pariputc('\n');
  407.       if (i && !(i % 60)) pariputc('\n');
  408.       if (i && !(i % 120)) {pariputs("---- (type return to continue) ----\n");getchar();}
  409.       pariputs(fonctions[i].name);
  410.       for(j = strlen(fonctions[i].name); j < 12; j++) pariputc(' ');
  411.     }
  412.   pariputc('\n');
  413. }
  414.  
  415. void globs(parisize,primelimit)
  416.      long parisize,primelimit;
  417. {
  418.   int i, j;
  419.   char thestring[70];
  420.   
  421.   for (i = 0; i < NUMGLOB; i++)
  422.     {
  423.       pariputc('\\'); pariputs(globales[i]);
  424.       for(j = strlen(globales[i]); j < 15; j++) pariputc(' ');
  425.       pariputs("= ");
  426.       switch (i)
  427.     {
  428.     case 0: sprintf(thestring, "%d",dec);break;
  429.     case 1: sprintf(thestring, "%d",precdl);break;
  430.     case 2: sprintf(thestring, "%c%d.%d",format,champ,nbchi);break;
  431.     case 3: sprintf(thestring, "%s",prompt);break;
  432.     }
  433.       pariputs(thestring); pariputc('\n');
  434.     }
  435.   sprintf(thestring, "stacksize = %ld, prime limit = %ld, buffersize = %ld",parisize, primelimit, paribuffsize);pariputs(thestring);
  436.   pariputc('\n');
  437. }
  438.  
  439. void aide(s)
  440.      char *s;
  441.      
  442. {
  443.   long  i, n, nparam;
  444.   char  *u = s;
  445.   entree *ep, **q;
  446.   
  447.   if (!*s) {commands(); return;}
  448.   for (n=0;n<NUMFUNC;n++)
  449.     if(!strcmp(fonctions[n].name,s))
  450.       {pariputs(helpmessage[n]); pariputc('.'); return;}
  451.   for(n = 0; isalnum(*u); u++) n = n << 1 ^ *u;
  452.   if (n < 0) n = -n; n %= TBLSZ;
  453.   for(ep = hashtable[n]; ep; ep = ep->next)
  454.     if(!strcmp(ep->name,s))
  455.       {
  456.     if (ep->valence != 100) break;
  457.     q = (entree **)(ep->value);
  458.     nparam = (long)*q++;
  459.     pariputs(ep->name);
  460.     pariputc('(');
  461.     for(i = 0; i < nparam; i++)
  462.       {
  463.         if(i) pariputc(',');
  464.         pariputs((*q++)->name);
  465.       }
  466.     pariputs(")= ");
  467.     pariputs(q);
  468.     return;
  469.       }
  470.   pariputs("Unknown function\n");
  471. }
  472.  
  473. /********************************************************************/
  474. /********************************************************************/
  475. /**                                                                **/
  476. /**                       MESURE DU TEMPS                          **/
  477. /**                                                                **/
  478. /********************************************************************/
  479. /********************************************************************/
  480.  
  481. #ifdef macintosh
  482.  
  483. pascal unsigned long TickCount(void) = 0xA975;
  484.      
  485. long timer()
  486. {
  487.   static long oldticks;
  488.   long ticks = TickCount();
  489.   long delay = ticks - oldticks;
  490.   oldticks = ticks;
  491.   return 50 * delay / 3;
  492. }
  493.  
  494. #else
  495.  
  496. long timer()
  497. {
  498.   static long oldmusec;
  499.   static long oldsec;
  500.   long delay;
  501.   struct rusage r;
  502.   struct timeval t;
  503.   getrusage(0,&r);t=r.ru_utime;
  504.   delay = 1000 * (t.tv_sec - oldsec) + (t.tv_usec - oldmusec) / 1000;
  505.   oldmusec = t.tv_usec;
  506.   oldsec = t.tv_sec;
  507.   return delay;
  508. }
  509.  
  510. #endif
  511.